﻿unit MVC.Redis;

interface

uses
  System.SysUtils, System.Variants, System.Classes, IdBaseComponent, IdCoderMIME,
  System.Generics.Collections, IdTCPConnection, IdTCPClient, IdGlobal, MVC.JSON,
  MVC.LogUnit, MVC.Config;

var
  Redis_IP: string;
  Redis_Port: Integer;
  Redis_PassWord: string;
  Redis_InitSize: integer;
  Redis_TimeOut: integer;
  Redis_ReadTimeOut: integer;

type
  TRedisItem = class
  private
    TcpClient: TIdTCPClient;
    isConn: Boolean;
    function HexToStr(S: string): string;
    function StrToHex(S: string): string;
  public
    function setText(key: string; value: string; timerout: Integer = 0): Boolean;
    function setJSON(key: string; value: IJObject; timerout: Integer = 0): Boolean;
    function getText(key: string): string;
    function getJSON(key: string): IJObject;
    function getCount: integer;
    function remove(key: string): Boolean;
    procedure setExpire(key: string; timerout: Integer);

    function tryconn(): Boolean;
    procedure freetcp;
    constructor Create();
    destructor Destroy; override;
  end;

  TRedisPoolItem = class
  private
    FisLock: Boolean;
    Fguid: string;
    Ftimerout: TDateTime;
    Fisdel: Boolean;
    procedure SetisLock(const Value: Boolean);
    procedure Setguid(const Value: string);
    procedure Settimerout(const Value: TDateTime);
    procedure Setisdel(const Value: Boolean);

  public
    item: TRedisItem;
    property isdel: Boolean read Fisdel write Setisdel;
    property timerout: TDateTime read Ftimerout write Settimerout;
    property guid: string read Fguid write Setguid;
    property isLock: Boolean read FisLock write SetisLock;
    constructor Create();
    destructor Destroy; override;
  end;

  TRedisPool = class(TThread)
  private
    initSize: integer;
    list: Tlist<TRedisPoolItem>;
    function GetGUID: string;
    function additem(): TRedisPoolItem;
  protected
    procedure Execute; override;
  public
    isclose: Boolean;
    procedure RunClear();
    function GetRedis(): TRedisPoolItem;
    function FreeRedis(guid: string): boolean;
    constructor Create(size: integer);
    destructor Destroy; override;
  end;

  IRedis = interface
    function setText(key: string; value: string; timerout: Integer = 0): Boolean;
    function setJSON(key: string; value: IJObject; timerout: Integer = 0): Boolean;
    function getText(key: string): string;
    function getJSON(key: string): IJObject;
    function getCount: integer;
    function remove(key: string): Boolean;
    procedure setExpire(key: string; timerout: Integer);
  end;

  TRedis = class(TInterfacedObject, IRedis)
  private
    ReidsPoolItem: TRedisPoolItem;

  public
    function setText(key: string; value: string; timerout: Integer = 0): Boolean;
    function setJSON(key: string; value: IJObject; timerout: Integer = 0): Boolean;
    function getText(key: string): string;
    function getJSON(key: string): IJObject;
    function getCount: integer;
    function remove(key: string): Boolean;
    procedure setExpire(key: string; timerout: Integer);

    constructor Create();
    destructor Destroy; override;

  end;

var
  RedisPool: TRedisPool;

function IIRedis: IRedis;

procedure CreateRedisPool;

implementation

{ TRedis }

function RedisReadParam: boolean;
begin
  if Redis_IP = '' then
  begin
    Redis_IP := Config.redis.Host;
    Redis_Port := config.redis.Port;
    Redis_PassWord := config.redis.PassWrod;
    Redis_InitSize := Config.redis.InitSize;
    Redis_TimeOut := Config.redis.TimeOut;
    Redis_ReadTimeOut := Config.redis.ReadTimeOut;
  end;
  Result := Config.redis.Host <> '';
end;

procedure CreateRedisPool;
begin
  if RedisReadParam then
  begin
    if not Assigned(RedisPool) then
      RedisPool := TRedisPool.Create(Redis_InitSize);
  end;
end;

function IIRedis: IRedis;
begin
  Result := TRedis.Create as IRedis;
end;

procedure RedisInit;
begin
  TThread.CreateAnonymousThread(
    procedure
    begin
      sleep(500);
      CreateRedisPool;
    end).Start;
end;

constructor TRedisItem.Create();
begin
//
end;

function TRedisItem.StrToHex(S: string): string;
var
  base64: TIdEncoderMIME;
 // tmpBytes: TBytes;
begin
  base64 := TIdEncoderMIME.Create(nil);
  try
    base64.FillChar := '=';
    Result := base64.EncodeString(S);
   // tmpBytes := TEncoding.UTF8.GetBytes(S);
   // Result := base64.EncodeBytes(TIdBytes(tmpBytes));
  finally
    base64.Free;
  end;
end;

function TRedisItem.HexToStr(S: string): string;
var
  base64: TIdDeCoderMIME;
 // tmpBytes: TBytes;
begin
  Result := S;
  base64 := TIdDecoderMIME.Create(nil);
  try
    base64.FillChar := '=';
   // tmpBytes := TBytes(base64.DecodeBytes(S));
    //Result := TEncoding.UTF8.GetString(tmpBytes);
    Result := base64.DecodeString(S);
  finally
    base64.Free;
  end;
end;

function TRedisItem.remove(key: string): Boolean;
var
  s: string;
begin

  if not tryconn then
  begin
    Result := false;
    exit;
  end;

  try

    tcpclient.Socket.WriteLn('del ' + key, IndyTextEncoding(IdTextEncodingType.encUTF8));
    s := tcpclient.Socket.ReadLn(IndyTextEncoding(IdTextEncodingType.encUTF8));
    Result := True;
  except
    on e: Exception do
    begin
      Result := False;
      log(e.Message);
    end;
  end;
end;

destructor TRedisItem.Destroy;
begin
  freetcp;
  inherited;
end;

procedure TRedisItem.freetcp;
begin
  if Assigned(TcpClient) then
  begin
    try
      if TcpClient.Connected then
        TcpClient.Disconnect;
    finally
      TcpClient.Free;
    end;
  end;
end;

function TRedisItem.setText(key, value: string; timerout: Integer = 0): Boolean;
var
  s, cmd: string;
begin
  Result := true;
  if not tryconn then
  begin
    Result := false;
    exit;
  end;

  try
    cmd := 'set ' + key + ' ' + StrToHex(value);
    tcpclient.Socket.WriteLn(cmd, IndyTextEncoding(IdTextEncodingType.encUTF8));
    s := tcpclient.Socket.ReadLn(IndyTextEncoding(IdTextEncodingType.encUTF8));
    if timerout > 0 then
      setExpire(key, timerout * 60)
    else
      setExpire(key, Redis_TimeOut * 60)
  except
    on e: Exception do
    begin
      Result := false;
      log(e.Message);
    end;
  end;
end;

function TRedisItem.setJSON(key: string; value: IJObject; timerout: Integer): Boolean;
begin
  Result := false;
  if value <> nil then
  begin
    Result := setText(key, value.toJSON, timerout);
  end;
end;

function TRedisItem.getCount: integer;
var
  s: string;
begin
  Result := -1;
  if not tryconn then
    exit;
  try
    with tcpclient do
    begin
      Socket.WriteLn('DBSIZE', IndyTextEncoding(IdTextEncodingType.encUTF8));
      s := Socket.ReadLn(IndyTextEncoding(IdTextEncodingType.encUTF8));
      if s <> '' then
        Result := StrToInt(Copy(s, 2, s.Length))
      else
        Result := -1;
    end;
  except
    on e: Exception do
    begin
      log(e.Message);
    end;
  end;
end;

function TRedisItem.getJSON(key: string): IJObject;
var
  txt: string;
begin
  Result := nil;
  if key.Trim <> '' then
  begin
    txt := getText(key);
    if txt.Trim <> '' then
    begin
      Result := IIJObject(txt);
    end
    else
      Result := IIJObject('{}');
  end;
end;

function TRedisItem.getText(key: string): string;
var
  s: string;
begin
  Result := '';
  if not tryconn then
  begin
    Result := '';
    exit;
  end;

  try
    with TcpClient do
    begin

      Socket.WriteLn('get ' + key, IndyTextEncoding(IdTextEncodingType.encUTF8));
      s := Socket.ReadLn(IndyTextEncoding(IdTextEncodingType.encUTF8));
      s := s.Replace('$', '');
      if StrToInt(s) > 0 then
      begin
        s := HexToStr(Socket.ReadLn(IndyTextEncoding(IdTextEncodingType.encUTF8)));
      end
      else
      begin
        s := '';
      end;

      Result := s;
    end;
  except
    on e: Exception do
    begin
      log(e.Message);
    end;
  end;
end;

function TRedisItem.tryconn: Boolean;
var
  s: string;
begin

  try
    try
      if not Assigned(tcpclient) then
        tcpclient := TIdTCPClient.Create(nil);
      if tcpclient.Connected then
      begin

        isConn := true;

        exit;
      end;
      tcpclient.Host := Redis_IP;
      tcpclient.Port := Redis_Port;
      TcpClient.ReadTimeout := Redis_ReadTimeOut * 1000;
      tcpclient.Connect;
      TcpClient.Socket.RecvBufferSize := 100 * 1024;
      TcpClient.Socket.SendBufferSize := 100 * 1024;

      with tcpclient do
      begin
        if Connected then
        begin
          if Redis_PassWord <> '' then
          begin
            Socket.WriteLn('AUTH ' + Redis_PassWord, IndyTextEncoding(IdTextEncodingType.encUTF8));
            s := Socket.ReadLn(IndyTextEncoding(IdTextEncodingType.encUTF8));
            if s = '+OK' then
            begin
              isConn := true;
            end
            else
            begin
              isConn := true;
              log('Redis服务登录失败请检测登录密码');
            end;
          end
          else
          begin
            isConn := true;
          end;
        end
        else
        begin
          isConn := false;
          log('Redis服务连接失败');
        end;
      end;
    except
      on e: Exception do
      begin
        isConn := false;
        log('Redis连接服务失败:' + e.Message);
      end;
    end;
  finally
    result := isConn;
  end;
end;

procedure TRedisItem.setExpire(key: string; timerout: Integer);
var
  s: string;
begin

  if not tryconn then
    exit;
  try
    with tcpclient do
    begin
      Socket.WriteLn('expire ' + key + ' ' + inttostr(timerout), IndyTextEncoding(IdTextEncodingType.encUTF8));
      s := Socket.ReadLn(IndyTextEncoding(IdTextEncodingType.encUTF8));
    end;
  except
    on e: Exception do
    begin
      log(e.Message);
    end;
  end;
end;

function TRedisPool.GetGUID: string;
var
  LTep: TGUID;
  sGUID: string;
begin
  CreateGUID(LTep);
  sGUID := GUIDToString(LTep);
  sGUID := StringReplace(sGUID, '-', '', [rfReplaceAll]);
  sGUID := Copy(sGUID, 2, Length(sGUID) - 2);
  result := sGUID;
end;

function TRedisPool.additem: TRedisPoolItem;
var
  item: TRedisPoolItem;
begin
  item := TRedisPoolItem.Create();
  item.isLock := false;
  item.isdel := false;
  item.guid := GetGUID;
  item.timerout := Now + (1 / 24 / 60) * 30; //24小时过期
  list.Add(item);
  Result := item;
end;

function TRedisPool.FreeRedis(guid: string): boolean;
var
  i: Integer;
begin
  Result := true;
  for i := 0 to list.Count - 1 do
  begin
    if list[i].guid = guid then
    begin
      list[i].isLock := false;
      break;
    end;
  end;
end;

constructor TRedisPool.Create(size: integer);
var
  i: integer;
begin
  inherited Create(False);
  if size = 0 then
    size := 1;
  initSize := size;
  list := TList<TRedisPoolItem>.Create();
  for i := 0 to size - 1 do
  begin
    additem();
  end;
end;

destructor TRedisPool.Destroy;
var
  i: Integer;
begin

  for i := 0 to list.Count - 1 do
  begin
    Lock(list);
    try
      list[i].Free;
    finally
      UnLock(list);
    end;
  end;
  list.Clear;
  list.Free;
  isclose := true;
  inherited;
end;

procedure TRedisPool.Execute;
var
  k: Integer;
begin
  k := 0;
  while not Terminated do
  begin

    try
      Inc(k);
      if k >= 100 then
      begin
        k := 0;
        RunClear;
      end;
    finally
      Sleep(10);
    end;
  end;
end;

function TRedisPool.GetRedis: TRedisPoolItem;
var
  i: Integer;
  isok: boolean;
begin
  Result := nil;
  isok := false;
  for i := 0 to list.Count - 1 do
  begin
    if (not list[i].isLock) and (not list[i].isdel) then
    begin
      isok := true;
      list[i].isLock := true;
      Result := list[i];
      break;
    end;
  end;
  if not isok then
  begin
    Result := additem;
  end;
end;

procedure TRedisPool.RunClear;
var
  sum, index: Integer;
begin
  try
    sum := list.Count - 1;
    index := 0;
    while index < sum - initSize do
    begin
      if list[index].isdel then
      begin
        Lock(list);
        try
          list[index].Free;
          list.Delete(index);
        finally
          UnLock(list);
        end;

        break;
      end;

      index := index + 1;
    end;
  except
    on e: Exception do
    begin
      log(e.Message);
    end;
  end;

  try
    sum := list.Count - 1;
    index := 0;
    while index < sum - initSize do
    begin
      if (not list[index].isLock) and (Now() >= list[index].timerout) then
      begin
        list[index].isdel := true;
        break;
      end;
      index := index + 1;
    end;
  except
    on e: Exception do
    begin
      log(e.Message);
    end;
  end;
end;

{ TRedis }

constructor TRedis.Create;
begin
  RedisReadParam;
  self.ReidsPoolItem := RedisPool.GetRedis;
end;

function TRedis.remove(key: string): Boolean;
begin
  Result := self.ReidsPoolItem.item.remove(key);
end;

destructor TRedis.Destroy;
begin
  RedisPool.FreeRedis(ReidsPoolItem.guid);
  inherited;
end;

function TRedis.getCount: integer;
begin
  Result := self.ReidsPoolItem.item.getCount;
end;

function TRedis.getJSON(key: string): IJObject;
begin
  Result := self.ReidsPoolItem.item.getJSON(key);
end;

function TRedis.getText(key: string): string;
begin
  Result := self.ReidsPoolItem.item.getText(key);
end;

procedure TRedis.setExpire(key: string; timerout: Integer);
begin
  self.ReidsPoolItem.item.setExpire(key, timerout);
end;

function TRedis.setJSON(key: string; value: IJObject; timerout: Integer): Boolean;
begin
  Result := self.ReidsPoolItem.item.setJSON(key, value, timerout);
end;

function TRedis.setText(key, value: string; timerout: Integer): Boolean;
begin
  Result := self.ReidsPoolItem.item.setText(key, value, timerout);
end;

{ TRedisItem }

constructor TRedisPoolItem.Create();
begin
  item := TRedisItem.Create();
end;

destructor TRedisPoolItem.Destroy;
begin
  item.Free;
  inherited;
end;

procedure TRedisPoolItem.Setguid(const Value: string);
begin
  Fguid := Value;
end;

procedure TRedisPoolItem.Setisdel(const Value: Boolean);
begin
  Fisdel := Value;
end;

procedure TRedisPoolItem.SetisLock(const Value: Boolean);
begin
  FisLock := Value;
end;

procedure TRedisPoolItem.Settimerout(const Value: TDateTime);
begin
  Ftimerout := Value;
end;

initialization
  RedisInit;

finalization
  if Assigned(RedisPool) then
    RedisPool.Free;

end.

